home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / build / process.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  4.4 KB  |  141 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2.  
  3. signature PROCESSFILE =
  4. sig
  5.   val dumpMap : unit -> unit
  6.   val prLambda : unit -> unit
  7.   val prFun : int -> unit
  8.   val process : Environment.staticEnv * string * (CPS.function * string 
  9.                     -> unit) option -> Environment.staticEnv
  10. end
  11.  
  12. structure ProcessFile : PROCESSFILE =
  13. struct
  14.   open Access Modules Types Variables PrintUtil ModuleUtil
  15.        ErrorMsg Absyn Lambda CompUtil
  16.  
  17.   fun for l f = app f l
  18.  
  19.   val saveLambda = System.Control.saveLambda
  20.   val lambda = ref (Lambda.RECORD [])
  21.   (* really needed only for interactive version *)
  22.   val _ = System.Control.prLambda :=
  23.           (fn () => (MCprint.printLexp(!lambda); newline()))
  24.   fun prLambda() = (MCprint.printLexp(!lambda); newline())
  25.   fun prFun lv = (MCprint.printFun(!lambda) lv; newline())
  26.  
  27.  
  28.   (* lvar -> string environment used by batch compiler to map module
  29.      lvars to names of modules *)
  30.   exception Modname
  31.   val m : string Intmap.intmap = Intmap.new(32, Modname)
  32.   val lookup = Intmap.map m
  33.   val enterName = Intmap.add m
  34.   fun lookupName v =
  35.       lookup v 
  36.       handle Modname => 
  37.      ErrorMsg.impossible ("Bad free variable: " ^ Access.lvarName v)
  38.   fun dumpMap() =
  39.       let val say = System.Print.say
  40.       fun p(i:int,s:string) = app say [makestring  i, " -> ", s, "\n"]
  41.       in  say "lvar -> structure mapping:\n"; Intmap.app p m
  42.       end
  43.  
  44.   fun process({static=env,inverse}, fname, gencode) : Environment.staticEnv =
  45.       let val stream = open_in fname
  46.       val source as {anyErrors,...} =
  47.         Source.newSource(fname,1,stream,false,
  48.                  ErrorMsg.defaultConsumer(),
  49.                  Index.openIndexFile fname)
  50.       val cummEnv = ref env
  51.           val cummInv = ref inverse
  52.  
  53.       fun proc(name,lvar,mkLam) =
  54.         let val _ = enterName(lvar, name)
  55.                 val getty = gengetty(!cummInv) 
  56.                 val lam = Opt.closestr(lookupName,getty,mkLam(), 
  57.                                        !CoreInfo.corePath)
  58.          in debugmsg "closed";
  59.                 if !saveLambda then lambda := lam else ();
  60.                 (case gencode
  61.                      of NONE => ()
  62.                | SOME gencode => gencode(convert lam, name));
  63.             if !anyErrors then raise Abort else ()
  64.         end
  65.  
  66.       fun comp absyn =
  67.           let fun pr () = 
  68.               PrettyPrint.with_pp (ErrorMsg.defaultConsumer())
  69.                (fn ppstrm =>
  70.              PPDec.ppDec (!cummEnv) ppstrm absyn
  71.                (fn _ => impossible "Process.f"))
  72.            in case absyn
  73.             of (SEQdec decs) => app comp decs
  74.              | (MARKdec(d,_,_)) => comp d
  75.              | (SIGdec sl) => pr ()
  76.              | (OPENdec _) => pr ()
  77.              | (FSIGdec _) => pr ()
  78.              | (STRdec sbs) =>
  79.              (pr ();
  80.               for sbs
  81.                 (fn sb as
  82.                 STRB{strvar as STRvar{name=n,
  83.                               access=PATH[v],...},
  84.                      ...} =>
  85.                    let fun mkLam() = transStrb(!cummEnv,sb,source)
  86.                 in proc(Symbol.name n, v, mkLam)
  87.                    end))
  88.              | (ABSdec sbs) =>
  89.              (pr ();
  90.               for sbs
  91.                 (fn sb as
  92.                 STRB{strvar as STRvar{name=n,
  93.                               access=PATH[v],...},
  94.                      ...} =>
  95.                    let fun mkLam() = transStrb(!cummEnv,sb,source)
  96.                 in proc(Symbol.name n, v, mkLam)
  97.                    end))
  98.              | (FCTdec fbs) =>
  99.              (pr ();
  100.               for fbs
  101.                 (fn fb as
  102.                 FCTB{fctvar as FCTvar{name,
  103.                               access=PATH[v],...},
  104.                      ...} =>
  105.                    let fun mkLam () =
  106.                        transFctb(!cummEnv,fb,source)
  107.                        handle Match => impossible
  108.                       "transFctb: match exception"
  109.                 in proc(Symbol.name name, v, mkLam)
  110.                    end))
  111.              | _ => error source (0,0) COMPLAIN
  112.                  "signature, functor, or structure expected"
  113.                  nullErrorBody
  114.           end
  115.  
  116.       val parser = Elaborate.parse (fn dec => dec) source
  117.  
  118.       fun loop () =
  119.           case (parser (!cummEnv))
  120.         of Elaborate.EOF =>
  121.              (Source.closeSource source;
  122.               if !anyErrors then raise Abort 
  123.                       else {static= !cummEnv,inverse= !cummInv})
  124.          | Elaborate.ABORT =>
  125.              (Source.closeSource source; raise Abort)
  126.          | Elaborate.ERROR =>
  127.              (Source.closeSource source; raise Abort)
  128.          | Elaborate.PARSE(absyn,envr) =>
  129.             let val {static=senv,inverse=ienv} = 
  130.                             Environment.makeStaticEnv(envr)
  131.                         val _ = (cummEnv := Env.atop(senv,!cummEnv))
  132.                         val _ = (cummInv := InverseEnv.atop(ienv,!cummInv))
  133.                      in comp absyn;
  134.                 loop()
  135.                     end
  136.  
  137.        in loop ()
  138.       end (* fun process *)
  139.  
  140. end (* structure ProcessFile *)
  141.